home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / win / vbsmpls.zip / SAMPLES / OLEDB / OLEDB.BAS < prev    next >
BASIC Source File  |  1994-03-24  |  5KB  |  120 lines
  1. '*******************************************************************'
  2. '*                                                                 *'
  3. '*  OLEDB.BAS - Routines that store and retrieve OLE objects       *'
  4. '*              and files in a database field.                     *'
  5. '*                                                                 *'
  6. '* NOTE: No error trapping has been implemented in this module.    *'
  7. '*                                                                 *'
  8. '*******************************************************************'
  9.  
  10. Option Explicit
  11.  
  12. Const OLE_SAVE_TO_FILE = 11     'OLE Action constant
  13. Const OLE_LOAD_FROM_FILE = 12   'OLE Action constant
  14.  
  15. Const CHUNK_SIZE = 32000        'Size of file transfer pieces
  16.  
  17. 'Extracts an Access 1.x OLE field and inserts the object in the
  18. 'OLE2 control
  19. '
  20. 'NOTE: No error trapping or checking implemented
  21. '
  22. Function AccessFieldToOLE (oleObject As Control, fdObject As Field)
  23.     Dim eError As Integer
  24.     Dim iFileNumber As Integer
  25.     Dim wOffsetToObject As Integer
  26.     iFileNumber = FreeFile                 'Get a free file number
  27.     Open App.Path & "\OLE.TMP" For Binary As iFileNumber 'Create temp
  28.     eError = FieldToFileStream(iFileNumber, fdObject) 'Get data
  29.     Get iFileNumber, 3, wOffsetToObject    'Get offset to object
  30.     Seek iFileNumber, wOffsetToObject + 1  'Move to start of object
  31.     oleObject.FileNumber = iFileNumber     'Point OLE control to file
  32.     oleObject.Action = OLE_LOAD_FROM_FILE  'Load OLE object from file
  33.     Close iFileNumber                      'Close temp file
  34.     Kill App.Path & "\OLE.TMP"             'Delete temp file
  35.     AccessFieldToOLE = 0         'Can be modified to return errors
  36. End Function
  37.  
  38. 'Extracts data from field and places it into a file stream
  39. '
  40. Function FieldToFileStream (iFileNumber As Integer, fdObject As Field) As Integer
  41.    Dim sChunkHolder As String
  42.    Dim lChunkCount As Long
  43.    Dim lChunkRemainder As Long
  44.    Dim i As Long
  45.    lChunkCount = fdObject.FieldSize() \ CHUNK_SIZE
  46.    lChunkRemainder = fdObject.FieldSize() Mod CHUNK_SIZE
  47.    For i = 0 To lChunkCount - 1
  48.       sChunkHolder = fdObject.GetChunk(i * CHUNK_SIZE, CHUNK_SIZE)
  49.       Put iFileNumber, , sChunkHolder
  50.    Next
  51.    If lChunkRemainder > 0 Then
  52.       sChunkHolder = fdObject.GetChunk(lChunkCount * CHUNK_SIZE, lChunkRemainder) 'Get remaining data
  53.       Put iFileNumber, , sChunkHolder
  54.    End If
  55.    FieldToFileStream = 0  'Can be modified to return errors
  56. End Function
  57.  
  58. 'Extracts OLE2 object from database and inserts it into the
  59. 'OLE2 control
  60. '
  61. 'NOTE: No error trapping or checking implemented
  62. '
  63. Function FieldToOLE (oleObject As Control, fdObject As Field)
  64.     Dim eError As Integer
  65.     Dim iFileNumber As Integer
  66.     iFileNumber = FreeFile
  67.     Open App.Path & "\OLE.TMP" For Binary As iFileNumber 'Create temp
  68.     eError = FieldToFileStream(iFileNumber, fdObject) 'Get data
  69.     Seek iFileNumber, 1                    'Move to start of file
  70.     oleObject.FileNumber = iFileNumber     'Point OLE control to file
  71.     oleObject.Action = OLE_LOAD_FROM_FILE  'Load OLE object from file
  72.     Close iFileNumber                      'Close temp file
  73.     Kill App.Path & "\OLE.TMP"             'Delete temp file
  74.     FieldToOLE = 0              'Can be modified to return errors
  75. End Function
  76.  
  77. 'Copies the remaining portion of an open file stream to a
  78. 'database field
  79. '
  80. Function FileStreamToField (iFileNumber As Integer, fdObject As Field) As Integer
  81.    Dim sChunkHolder As String
  82.    Dim lChunkCount As Long
  83.    Dim lChunkRemainder As Long
  84.    Dim i As Long
  85.    sChunkHolder = Space$(CHUNK_SIZE)
  86.    lChunkCount = (LOF(iFileNumber) - Seek(iFileNumber) + 1) \ CHUNK_SIZE
  87.    lChunkRemainder = (LOF(iFileNumber) - Seek(iFileNumber) + 1) Mod CHUNK_SIZE
  88.    For i = 1 To lChunkCount
  89.       Get iFileNumber, , sChunkHolder
  90.       fdObject.AppendChunk (sChunkHolder)
  91.    Next
  92.    If lChunkRemainder > 0 Then
  93.       sChunkHolder = Space$(lChunkRemainder)
  94.       Get iFileNumber, , sChunkHolder
  95.       fdObject.AppendChunk (sChunkHolder)
  96.    End If
  97.    FileStreamToField = 0           'Can be modified to return errors
  98. End Function
  99.  
  100. 'Extracts the OLE2 object from the OLE2 control and places it into
  101. 'the database field
  102. '
  103. 'NOTE: No error trapping or checking implemented
  104. '
  105. Function OLEToField (oleObject As Control, fdObject As Field) As Integer
  106.    Dim eError As Integer
  107.    Dim iFileNumber As Integer
  108.    iFileNumber = FreeFile
  109.    Open App.Path & "\OLE.TMP" For Binary As iFileNumber 'Create temp
  110.    oleObject.FileNumber = iFileNumber   'Point OLE control to file
  111.    oleObject.Action = OLE_SAVE_TO_FILE  'Store OLE object in temp file
  112.    Seek iFileNumber, 1                  'Move to stream start
  113.    fdObject = ""                                     'Clear field
  114.    eError = FileStreamToField(iFileNumber, fdObject) 'Put data
  115.    Close iFileNumber                'Close temp file
  116.    Kill App.Path & "\OLE.TMP"       'Delete temp file
  117.    OLEToField = 0                'Can be modified to return errors
  118. End Function
  119.  
  120.